home *** CD-ROM | disk | FTP | other *** search
Text File | 1999-04-24 | 14.5 KB | 439 lines | [TEXT/ALFA] |
- ## -*-Tcl-*-
- # ###################################################################
- # CSS mode - tools for editing CSS documents
- #
- # FILE: "cssMode.tcl"
- # created: 97-03-01 16.02.41
- # last update: 99-04-24 13.20.31
- # Author: Johan Linde
- # E-mail: <jlinde@telia.com>
- # www: <http://www.theophys.kth.se/~jl/Alpha.html>
- #
- # Version: 1.1.1
- #
- # Copyright 1997-1999 by Johan Linde
- #
- # This software may be used freely, and distributed freely, as long as the
- # receiver is not obligated in any way by receiving it.
- #
- # If you make improvements to this file, please share them!
- #
- # ###################################################################
- ##
-
- # Defining CSS mode
-
- if {[alpha::package vsatisfies ${alpha::version} 7.1b1]} {
- alpha::mode CSS 1.1.1 cssMenu {*.css *.CSS} {
- cssMenu electricBraces electricSemicolon electricReturn electricTab
- } {
- addMenu cssMenu •150
- } uninstall {
- set __dir [file dirname [procs::find cssMenu]]
- catch {removeFile $__dir:cssMode.tcl}
- if {[procs::find htmlMenu] == ""} {
- catch {removeFile $__dir:hctsmsl.tcl}
- catch {removeFile $__dir:hctsmslShared.tcl}
- catch {removeFile $__dir:hctsmslMenu.tcl}
- catch {removeFile "$HOME:Help:HTML Help"}
- catch {removeFile "$HOME:Tcl:Completions:CSSCompletions.tcl"}
- }
- } maintainer {
- "Johan Linde" jlinde@telia.com <http://www.theophys.kth.se/~jl/Alpha.html>
- } help {file "HTML Help"}
- catch {unset CSSmodeVars(elecRBrace)}
- catch {unset CSSmodeVars(elecLBrace)}
- catch {unset CSSmodeVars(electricSemi)}
- } else {
- ;alpha::mode CSS 1.1.1 cssMenu {*.css *.CSS} cssMenu {
- addMenu cssMenu •150
- } uninstall {
- set __dir [file dirname [procs::find cssMenu]]
- catch {removeFile $__dir:cssMode.tcl}
- if {[procs::find htmlMenu] == ""} {
- catch {removeFile $__dir:hctsmsl.tcl}
- catch {removeFile $__dir:hctsmslShared.tcl}
- catch {removeFile $__dir:hctsmslMenu.tcl}
- catch {removeFile "$HOME:Help:HTML Help"}
- catch {removeFile "$HOME:Tcl:Completions:CSSCompletions.tcl"}
- }
- } maintainer {
- "Johan Linde" jlinde@telia.com <http://www.theophys.kth.se/~jl/Alpha.html>
- } help {file "HTML Help"}
- # Electric left brace?
- newPref f elecRBrace 1 CSS
- # Electric right brace?
- newPref f elecLBrace 1 CSS
- # Electric semicolon?
- newPref f electricSemi 1 CSS
- }
-
- proc cssMenu {} {}
-
- newPref f wordWrap 0 CSS
- newPref v wordBreak {\w+} CSS
- newPref v wordBreakPreface {\W} CSS
- # Color of comments
- newPref v commentColor red CSS
- # Color of CSS keywords
- newPref v keywordColor blue CSS
- # Color of HTML elements
- newPref v htmlColor magenta CSS
- # Cmd-double-click on non text file link opens file?
- newPref f openNonTextFile 1 CSS
-
- # Coloring
- proc cssColoring {} {
- global CSSmodeVars
- regModeKeywords -b {/*} {*/} -c $CSSmodeVars(commentColor) -k $CSSmodeVars(htmlColor) CSS [cssGetHtmlWords]
- regModeKeywords -a -k $CSSmodeVars(keywordColor) CSS {
- font-family font-style font-variant font-weight font-size font
- color background-color background-image background-repeat background-attachment
- background-position background word-spacing letter-spacing text-decoration
- vertical-align text-transform text-align text-indent line-height
- margin-top margin-right margin-bottom margin-left margin padding-top padding-right
- padding-bottom padding-left padding border-top-width border-right-width
- border-bottom-width border-left-width border-width border-color border-style
- border-top border-right border-bottom border-left border width height float clear
- display white-space list-style-type list-style-image list-style-position list-style
- @import important
- link visited active first-letter first-line}
- }
-
- # Load other CSS mode files.
- foreach tmp {hctsmsl hctsmslShared hctsmslMenu} {
- if {[info exists htmlModeIsLoaded] && ($tmp == "hctsmslMenu" || $tmp == "hctsmslShared")} {continue}
- if {$tmp == "hctsmsl" && [info exists cssUnits]} {continue}
- if { [catch {${tmp}.tcl}] } {
- beep
- alertnote "Loading of ${tmp}.tcl failed"
- return
- }
- }
-
- proc cssHTMLelement {elem} {
- replaceText [getPos] [selEnd] $elem
- }
-
-
- proc CSSDividingLine {} {
- insertText "/*=============================================================================*/\r"
- }
- bind 'l' <C> CSSDividingLine CSS
-
-
- proc CSS::electricSemi {} {
- insertText ";\r" [text::indentString [getPos]]
- }
-
- proc CSS::parseFuncs {} {
- set pos 0
- set funcExpr {^[ \t]*([^\r\{]+)\{}
- while {[set res [search -s -f 1 -r 1 -i 0 -n $funcExpr $pos]] != ""} {
- if {[regexp $funcExpr [getText [car $res] [cadr $res]] dummy word]} {
- lappend m [list $word [car $res]]
- }
- set pos [cadr $res]
- }
- return [join [lsort -ignore $m]]
- }
-
- #===============================================================================
- # Key bindings
- #===============================================================================
-
- # Define key bindings from html menu.
- proc cssBindingsFromMenu {me tmplist} {
- global htmlMenuKey html${me}Sub
- upvar $tmplist tmp
- foreach it [set html${me}Sub] {
- if {[llength $it] > 2} {
- set elem [lindex $it 2]
- if {[info exists htmlMenuKey(${me}/[lindex $it 1])]} {
- set key $htmlMenuKey(${me}/[lindex $it 1])
- } else {
- set key [lindex $it 0]
- }
- cssBindOneKey $key $elem "" tmp
- }
- }
- }
-
- proc cssBindOneKey {key elem {un ""} {tmplist ""}} {
- set key1 [keys::toBind $key]
- # Work around bug in keys::toBind
- if {[regexp "/b" $key]} {set key1 [lreplace $key1 0 0 0x24]}
- if {$key1 == ""} {return}
- eval ${un}bind $key1 [list "cssHTMLelement $elem"] CSS
- if {$tmplist != ""} {
- upvar $tmplist tmp
- append tmp [concat ${un}bind $key1 [list "cssHTMLelement $elem"] CSS] \r
- }
- }
-
- # Redefine key bindings when changed in HTML menu.
- proc cssReBindKey {meny keyItems} {
- global html${meny}Sub
- set items [set html${meny}Sub]
- foreach it $keyItems {
- set it0 [lindex $it 0]
- foreach it1 $items {
- if {[lindex $it1 1] == $it0} {
- set elem [lindex $it1 2]
- break
- }
- }
- # Skip those which aren't html elements
- if {[llength $it1] < 3} {continue}
- cssBindOneKey [lindex $it 1] $elem un
- cssBindOneKey [lindex $it 2] $elem
- }
- }
-
- proc cssMenuKeys {} {
- global htmlMenuKey
- set rebuildCSS 0
- set somethingModified 0
- htmlReadMenuKeys
- htmlSetKeysInMenu CSS
- if {$somethingModified} {htmlWriteMenuKeys}
- catch {unset htmlMenuKey}
- if {$rebuildCSS} {cssRebuildMenu}
- }
-
- #===============================================================================
- # Menu handling
- #===============================================================================
-
- set htmlCSSSub [concat [lrange $htmlStyleSub 3 end] {"(-" {"<O<U/S" "Reload in Browser"} {"" "Colors…"} {"" "Key Bindings…"} {"" "Preferences…"}}]
-
- proc cssBuildMenu {} {
- global cssMenu htmlMenuKey
- if {[catch {htmlReadCache "CSS menu cache" css}]} {
- htmlReadMenuKeys
- set me [htmlBuildOneMenu CSS]
- menu -M CSS -p cssMenuItem -m -n $cssMenu $me
- set h {menu -M CSS -p cssMenuItem -m -n $cssMenu}
- lappend h $me
- htmlSaveCache "CSS menu cache" $h css
- }
- catch {unset htmlMenuKey}
- }
-
- proc cssRebuildMenu {} {
- htmlDeleteCache "CSS menu cache"
- cssBuildMenu
- }
-
- proc cssMenuItem {menu item} {
- switch $item {
- "Reload in Browser" {cssReloadinBrowser}
- Colors {htmlColors}
- "Key Bindings" {cssMenuKeys}
- "Preferences" {CSSmodifyFlags}
- Import {cssDialog @import}
- Display {cssDialog Display}
- default {cssDialog [join [string tolower $item] -]}
- }
- }
-
- #===============================================================================
- # Cmd-double-click
- #===============================================================================
-
- proc CSS::DblClick {from to} {
- HTML::DblClick $from $to
- }
-
- #===============================================================================
- # Reload in Browser
- #===============================================================================
-
- proc cssReloadinBrowser {} {
- global browserSig HTMLmodeVars
- if {$browserSig != "MOSS" && $browserSig != "MSIE" && $browserSig != "iCAB"} {
- beep; message "Works only with Netscape, MSIE, and iCab."; return
- }
- # returns window ids
- if {![regexp {\[([0-9]+)} [AEBuild -r '$browserSig' WWW! LSTW] dum winnum]} {beep; message "No browser window."; return}
- if {[winDirty]} {
- if {[set ask [askyesno -c "Save '[lindex [winNames] 0]'?"]] == "yes"} {
- save
- } elseif {$ask == "cancel"} {
- return
- }
- }
- # returns window info
- regexp {\[([^ ]+)} [AEBuild -r '$browserSig' WWW! WNFO ---- $winnum] dum winurl
- set winurl [string trim $winurl "“”,"]
- if {$winurl == "'TEXT'()"} {beep; message "Empty browser window."; return}
- # reloads window
- set flgs ""
- if {$browserSig == "MSIE"} {set flgs "FLGS 1"}
- if {$browserSig == "iCAB"} {
- AEBuild '$browserSig' core clos "----" "obj{form:indx, want:type(cwin), seld:1, from:'null'()}"
- }
- eval AEBuild '$browserSig' WWW! OURL ---- "“$winurl”" $flgs
- if {![info exists HTMLmodeVars(browseInForeground)] || $HTMLmodeVars(browseInForeground)} {switchTo '$browserSig'}
- }
-
-
- #===============================================================================
- # Preferences
- #===============================================================================
-
- if {![alpha::package vsatisfies ${alpha::version} 7.1b1]} {
- proc CSSmodifyFlags {} {
- global CSSmodeVars modifiedModeVars colorInds
- set colors {none blue cyan green magenta red white yellow}
- foreach c [lsort [array names colorInds]] {
- if {[regexp {color} $c]} {lappend colors $c}
- }
- set box "-t {CSS mode Preferences} 100 10 450 30 \
- -c {Electric left braces} $CSSmodeVars(elecLBrace) 10 35 450 50 \
- -c {Electric right braces} $CSSmodeVars(elecRBrace) 10 55 450 70 \
- -c {Electric semicolon} $CSSmodeVars(electricSemi) 10 75 450 90 \
- -c {Cmd-double-clicking on non-text file link opens file} $CSSmodeVars(openNonTextFile) 10 95 450 110 \
- -t {Color of keywords:} 10 115 150 130 \
- -m [list [concat $CSSmodeVars(keywordColor) $colors]] 160 115 310 135 \
- -t {Color of comments:} 10 140 150 155 \
- -m [list [concat $CSSmodeVars(commentColor) $colors]] 160 140 310 155 \
- -t {Color of HTML:} 10 165 150 180 \
- -m [list [concat $CSSmodeVars(htmlColor) $colors]] 160 165 310 180 \
- -t wordBreak: 10 190 150 205 \
- -e [list $CSSmodeVars(wordBreak)] 155 190 450 205 \
- -t wordBreakPreface: 10 215 150 230 \
- -e [list $CSSmodeVars(wordBreakPreface)] 155 215 450 230"
- set values [eval [concat dialog -w 460 -h 275 -b OK 20 245 85 265 -b Cancel 110 245 175 265 $box]]
- if {[lindex $values 1]} {return}
- set i 1
- foreach flag {elecLBrace elecRBrace electricSemi openNonTextFile keywordColor
- commentColor htmlColor wordBreak wordBreakPreface} {
- global $flag
- incr i
- set val [lindex $values $i]
- if {$CSSmodeVars($flag) != $val} {
- set $flag $val
- set CSSmodeVars($flag) $val
- lappend modifiedModeVars [list $flag CSSmodeVars]
- if {[string match "*Color" $flag]} {cssColoring}
- }
- }
- }
- } else {
- proc CSSmodifyFlags {} {
- global CSSmodeVars modifiedModeVars colorInds
- set colors {none blue cyan green magenta red white yellow}
- foreach c [lsort [array names colorInds]] {
- if {[regexp {color} $c]} {lappend colors $c}
- }
- set box "-t {CSS mode Preferences} 100 10 450 30 \
- -c {Cmd-double-clicking on non-text file link opens file} $CSSmodeVars(openNonTextFile) 10 35 450 50 \
- -t {Color of keywords:} 10 55 150 70 \
- -m [list [concat $CSSmodeVars(keywordColor) $colors]] 160 55 310 75 \
- -t {Color of comments:} 10 80 150 95 \
- -m [list [concat $CSSmodeVars(commentColor) $colors]] 160 80 310 100 \
- -t {Color of HTML:} 10 105 150 120 \
- -m [list [concat $CSSmodeVars(htmlColor) $colors]] 160 105 310 120 \
- -t wordBreak: 10 130 150 145 \
- -e [list $CSSmodeVars(wordBreak)] 155 130 450 145 \
- -t wordBreakPreface: 10 155 150 170 \
- -e [list $CSSmodeVars(wordBreakPreface)] 155 155 450 170"
- set values [eval [concat dialog -w 460 -h 215 -b OK 20 185 85 205 -b Cancel 110 185 175 205 $box]]
- if {[lindex $values 1]} {return}
- set i 1
- foreach flag {openNonTextFile keywordColor
- commentColor htmlColor wordBreak wordBreakPreface} {
- global $flag
- incr i
- set val [lindex $values $i]
- if {$CSSmodeVars($flag) != $val} {
- set $flag $val
- set CSSmodeVars($flag) $val
- lappend modifiedModeVars [list $flag CSSmodeVars]
- if {[string match "*Color" $flag]} {cssColoring}
- }
- }
- }
- }
- #===============================================================================
- # Initialization
- #===============================================================================
-
- set cssVersion 2.14
-
- # Define key bindings.
- if {[catch {htmlReadCache "CSS keybindings cache" css}]} {
- htmlReadMenuKeys
- message "Defining key bindings…"
- foreach tmp [lrange $htmlSubMenus $htmlStartElements end] {
- cssBindingsFromMenu [lindex $tmp 0] tmplist
- }
- if {[info exists htmlModeIsLoaded]} {
- foreach tmp [array names htmlElemKeyBinding] {
- cssBindOneKey $htmlElemKeyBinding($tmp) $tmp "" tmplist
- }
- } elseif {[file exists $PREFS:HTMLadditions.tcl]} {
- set tmpcid [scancontext create]
- scanmatch $tmpcid {htmlElemKeyBinding} {
- cssBindOneKey [lindex [lindex $matchInfo(line) 1] 2] [lindex $matchInfo(line) 0] "" tmplist
- }
- if {![catch {open $PREFS:HTMLadditions.tcl} tmpfid]} {
- scanfile $tmpcid $tmpfid
- close $tmpfid
- }
- scancontext delete $tmpcid
- catch {unset tmpcid tmpfid}
- }
- htmlSaveCache "CSS keybindings cache" $tmplist css
- unset tmplist
- catch {unset htmlMenuKey}
- } else {
- message "Reading key bindings…"
- }
-
- if {![info exists htmlModeIsLoaded]} {
- set cssHtmlWords {A ABBR ACRONYM ADDRESS APPLET AREA B BASE
- BASEFONT BDO BGSOUND BIG BLINK BLOCKQUOTE BODY BR BUTTON CAPTION
- CENTER CITE CODE COL COLGROUP DD DEL DFN DIR DIV DL DT EM EMBED
- FIELDSET FONT FORM FRAME FRAMESET H1 H2 H3 H4 H5 H6 HEAD HR HTML I
- IFRAME ILAYER IMG INPUT INS ISINDEX KBD KEYGEN LABEL LAYER LEGEND
- LI LINK MAP MARQUEE MENU META MULTICOL NOBR NOEMBED NOFRAMES
- NOLAYER NOSCRIPT OBJECT OL OPTGROUP OPTION P PARAM PRE Q SAMP
- SCRIPT SELECT SERVER SMALL SPACER SPAN STRIKE STRONG STYLE SUB SUP TABLE
- TBODY TD TEXTAREA TFOOT TH THEAD TITLE TR TT U UL VAR WBR}
- if {[file exists $PREFS:HTMLadditions.tcl]} {
- set tmpcid [scancontext create]
- scanmatch $tmpcid {htmlElemKeyBinding} {
- lappend cssHtmlWords [lindex $matchInfo(line) 0]
- }
- if {![catch {open $PREFS:HTMLadditions.tcl} tmpfid]} {
- scanfile $tmpcid $tmpfid
- close $tmpfid
- }
- scancontext delete $tmpcid
- catch {unset tmpcid tmpfid}
- }
- }
-
- cssColoring
- cssBuildMenu
- unset tmp
- rename cssBindingsFromMenu ""
-
-
- set commentCharacters(CSS:General) "/*"
- set commentCharacters(CSS:Paragraph) [list "/* " " */" " * "]
- set commentCharacters(CSS:Box) [list "/*" 2 "*/" 2 "*" 3]
-
-
- if {[info exists htmlModeIsLoaded] && $htmlVersion != $cssVersion} {
- alertnote "Warning: The versions of HTML mode and CSS mode may not be compatible.\
- Always install new versions of HTML mode and CSS mode simultaneously."
- }
-
- set cssModeIsLoaded 1
-
- message "CSS initialization complete."
-
-